home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpcom.zip / IBMCOMT.PAS < prev    next >
Pascal/Delphi Source File  |  1992-08-11  |  2KB  |  81 lines
  1. PROGRAM ibmcomt;
  2.  
  3. {Simple test program for IBMCOM.  Acts like a dumb terminal at a fixed
  4. speed and with no commands except for Alt-X, to exit the program.
  5. Obviously, it doesn't test all of IBMCOM, but it tests the most
  6. important parts -- receiving and sending characters.}
  7.  
  8.  
  9. USES
  10.   Crt, ibmcom;
  11.  
  12.  
  13. {Read a key from the keyboard.  If it's an ordinary key, the ascii code
  14. is returned in ch1 and ch2 is #0.  If it's a function key, ch1 is 0 and
  15. the scan code is in ch2.}
  16.  
  17. PROCEDURE read_key (VAR ch1, ch2: Char);
  18. BEGIN
  19.   ch1 := ReadKey;
  20.   IF ch1 = #0 THEN
  21.     ch2 := ReadKey
  22.   ELSE
  23.     ch2 := #0;
  24. END;
  25.  
  26.  
  27. CONST
  28.   port          = 1;
  29.   initial_speed = 19200;
  30.  
  31. VAR
  32.   result   : Word;
  33.   exit_prog: Boolean;
  34.   ch1, ch2 : Char;
  35.   ch3      : Char;
  36.  
  37. BEGIN
  38.  
  39. clrscr;
  40.  
  41. Writeln('Simple Terminal');
  42. write('Port: ',port);
  43. writeln(' Speed Set To: ',initial_speed);
  44. writeln('Enter Alt-X to exit Program');
  45.  
  46.  
  47.   ComInstall (port, result);
  48.   IF result <> 0 THEN
  49.     BEGIN
  50.     CASE result OF
  51.       1: Writeln ('Invalid port number: ', port);
  52.       2: Writeln ('No hardware for port ', port);
  53.       3: Writeln ('Driver already installed');
  54.     ELSE
  55.       Writeln ('Unexpected ComInstall error ', result);
  56.       END;
  57.     Exit;
  58.     END;
  59.   ComRaiseDTR;
  60.   ComSetSpeed (initial_speed);
  61.   ComSetParity (ComNone, 1);
  62.   exit_prog := False;
  63.  
  64.   REPEAT
  65.     IF KeyPressed THEN
  66.       BEGIN
  67.       read_key (ch1, ch2);
  68.       IF ch1 <> #0 THEN
  69.         ComTx (ch1)
  70.       ELSE
  71.         CASE ch2 OF
  72.           #45: {Alt-X}
  73.             exit_prog := True;
  74.           END;
  75.       END;
  76.     ch3 := ComRx;
  77.     IF ch3 <> #0 THEN
  78.       Write (ch3);
  79.   UNTIL exit_prog;
  80. END.
  81.